home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 2 / Meeting Pearls Vol. II (1995)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon4Amiga / ETH_Tools / XE.Mod (.txt) < prev   
Oberon Text  |  1994-10-21  |  47KB  |  981 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 27 Sep 94
  6. Syntax10b.Scn.Fnt
  7. Syntax12i.Scn.Fnt
  8. FoldElems
  9. LineElems
  10. Alloc
  11. Syntax10i.Scn.Fnt
  12. (* Other Oberons *)
  13. Syntax10i.Scn.Fnt
  14. (* Ceres Oberon *)
  15. Syntax10i.Scn.Fnt
  16. (* all Oberons without the object model (all except HP, DEC, SGI) *)
  17. Syntax10i.Scn.Fnt
  18. (* all Oberons with the object model (HP, DEC, SGI) *)
  19. MODULE XE;    (** SHML 10 Dec 90; 
  20.     (* eXtended Edit: Supports various enhancements over usual TextFrames.Handle for programmer's purposes *)
  21.     (* adjust Delay, HandleCall *)
  22.     (* Declarations *)
  23.     IMPORT Modules, Display, Input, Files, Fonts, Texts, Viewers, Oberon, TextFrames, MenuViewers, FoldElems;
  24.     CONST
  25.         GetHandlerKey* = -210566;    (** secret number to get XE.Handle  **)
  26.         DefErrFile = "OberonErrors.Text"; ErrFont = "Syntax8.Scn.Fnt";
  27.         ML = 2; MM = 1; MR = 0;
  28.         CtrlB = 2X; CtrlD = 4X; CtrlE = 5X; CtrlF = 6X; BS = 08X; LF = 0AX; CtrlK = 0BX; CR = 0DX; CtrlN = 0EX;
  29.         CtrlP = 10X; CtrlT = 14X; CtrlW = 17X; CtrlX = 18X; CtrlZ = 1AX;
  30.         UpArrow = 0C1X; DnArrow = 0C2X;
  31.         MaxPat = 32;
  32.         OptionChar1 = "/"; OptionChar2 = "\";    (* character used by host Oberon System for introducing options *)
  33.         Version = "XE  (SHML  27 Sep 94)";
  34.         MenuText = "XE.Menu.Text";
  35.         KeyHandler = "EditKeys.GetKeyHandler";
  36.         DefComp = "Compiler.Compile";    (* default compiler command *)
  37.         OpenCmd = "Doc.Open";    (* command used by OpenCall *)
  38.         Delay = 
  39. Input.TimeUnit DIV 2;
  40. ;    (* 0.5 seconds, adjust if necessary! *)
  41.     TYPE
  42.         LongName = ARRAY 128 OF CHAR;
  43.         Name = ARRAY 32 OF CHAR;
  44.         Elem = POINTER TO ElemDesc;
  45.         ElemDesc = RECORD (Texts.ElemDesc)
  46.             err: INTEGER;
  47.             pos: LONGINT;
  48.             wide: BOOLEAN;
  49.             num: ARRAY 8 OF CHAR;
  50.             msg: LongName
  51.         END;
  52.         Element = POINTER TO ElementDesc;
  53.         ElementDesc = RECORD
  54.             compiler, ext: Name; errFile: LongName;
  55.             next: Element
  56.         END;
  57.         wr: Texts.Writer;
  58.         errT: Texts.Text; errFnt: Fonts.Font;
  59.         keyHandle: Display.Handler;
  60.         compiler, defComp: Name;
  61.         first: BOOLEAN;
  62.         root: Element;
  63.         find: RECORD
  64.             len: LONGINT;
  65.             buf: ARRAY MaxPat OF CHAR
  66.         END;
  67.     (* Support *)
  68.     PROCEDURE Str(s: ARRAY OF CHAR);    BEGIN Texts.WriteString(wr, s) END Str;
  69.     PROCEDURE Ch(ch: CHAR);    BEGIN Texts.Write(wr, ch) END Ch;
  70.     PROCEDURE Ln;    BEGIN Texts.WriteLn(wr); Texts.Append(Oberon.Log, wr.buf) END Ln;
  71.     PROCEDURE Extension(name: ARRAY OF CHAR; VAR ext: ARRAY OF CHAR);    (* get extension of name *)
  72.         VAR i, j: INTEGER;
  73.     BEGIN
  74.         i := -1; REPEAT INC(i) UNTIL name[i] = 0X;
  75.         REPEAT DEC(i) UNTIL (name[i] = ".") OR (i = 0);
  76.         IF i = 0 THEN ext[0] := 0X
  77.         ELSE j := -1; REPEAT INC(i); INC(j); ext[j] := name[i] UNTIL name[i] = 0X
  78.         END
  79.     END Extension;
  80.     PROCEDURE Append(src: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);    (* append src to dest if no "." in src *)
  81.         VAR i, off: INTEGER;
  82.     BEGIN
  83.         off := -1; REPEAT INC(off) UNTIL (dest[off] = 0X) OR (dest[off] = ".");
  84.         IF dest[off] # "." THEN i := -1; REPEAT INC(i); dest[i+off] := src[i] UNTIL src[i] = 0X END
  85.     END Append;
  86.     PROCEDURE SearchPair(ext: ARRAY OF CHAR; VAR prev: Element): Element;    
  87.         VAR l: Element;
  88.     BEGIN
  89.         l := root; prev := NIL; WHILE (l # NIL) & (l.ext # ext) DO prev := l; l := l.next END;
  90.         RETURN l
  91.     END SearchPair;
  92.     PROCEDURE ScanFirst(VAR s: Texts.Scanner);    (* Scan first parameter *)
  93.         VAR sel: Texts.Text; beg, end, time: LONGINT;
  94.     BEGIN
  95.         Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  96.         IF (s.class = Texts.Char) & (s.line = 0) & (s.c = "^") THEN
  97.             Oberon.GetSelection(sel, beg, end, time);
  98.             IF time >= 0 THEN Texts.OpenScanner(s, sel, beg); Texts.Scan(s) END
  99.         END
  100.     END ScanFirst;
  101.     PROCEDURE InstallKeyHandler;    
  102.         VAR save, par: Oberon.ParList; res: INTEGER;
  103.     BEGIN
  104.         save := Oberon.Par;
  105.         NEW(par); NEW(par.frame); par.frame.X := 0; par.frame.Y := 0; par.pos := -42;    (* magic *)
  106.         Oberon.Call(KeyHandler, par, FALSE, res);
  107.         IF res = 0 THEN keyHandle := Oberon.Par.frame.handle
  108.         ELSE keyHandle := NIL
  109.         END;
  110.         Oberon.Par := save; Modules.res := 0    (* bug in Modules? *)
  111.     END InstallKeyHandler;
  112.     PROCEDURE OpenText(VAR t: Texts.Text; VAR name: ARRAY OF CHAR;
  113.             s: Texts.Scanner; default, ext1, ext2: ARRAY OF CHAR);    
  114.         VAR extName: LongName; i, len: INTEGER;
  115.         PROCEDURE Extend(VAR str: ARRAY OF CHAR; with: ARRAY OF CHAR);    (* extend str with with *)
  116.             VAR ls, le: INTEGER;
  117.         BEGIN
  118.             ls := -1; REPEAT INC(ls) UNTIL str[ls] = 0X;
  119.             le := -1; REPEAT INC(le) UNTIL with[le] = 0X;
  120.             IF ls <= LEN(str)-le THEN
  121.                 INC(ls, le); REPEAT str[ls] := with[le]; DEC(ls); DEC(le) UNTIL le = -1
  122.             END
  123.         END Extend;
  124.         PROCEDURE Try(): BOOLEAN;    (* try opening name with ext1 or ext2 appended to it *)
  125.         BEGIN
  126.             COPY(name, extName); Extend(extName, ext1); t := TextFrames.Text(extName);
  127.             IF t.len = 0 THEN COPY(name, extName); Extend(extName, ext2); t := TextFrames.Text(extName) END;
  128.             RETURN t.len > 0
  129.         END Try;
  130.     BEGIN
  131.         IF first THEN first := FALSE; Str(Version); Ln; InstallKeyHandler END;    (* write a startup message to the Log (once) *)
  132.         find.len := 0;
  133.         IF s.class = Texts.String THEN
  134.             t := TextFrames.Text(s.s);
  135.             name[0] := '"';
  136.             FOR i := 0 TO s.len-1 DO name[i+1] := s.s[i] END;
  137.             name[i] := '"'; name[i+1] := 0X
  138.         ELSIF s.class # Texts.Name THEN t := TextFrames.Text(default); COPY(default, name)
  139.         ELSE
  140.             COPY(s.s, name); t := TextFrames.Text(name);    (* use original name *)
  141.             IF t.len = 0 THEN    (* name doesn't exist *)
  142.                 IF Try() THEN COPY(extName, name)    (* use extended name *)
  143.                 ELSE
  144.                     len := s.len; REPEAT DEC(len) UNTIL (name[len] = ".") OR (len = 0);
  145.                     IF len # 0 THEN    (* name[len] = "." *)
  146.                         i := -1;    (* copy appended name to pattern for Edit.Show *)
  147.                         REPEAT INC(i); find.buf[i] := name[i+len+1] UNTIL find.buf[i] = 0X;
  148.                         find.buf[i] := "*"; find.buf[i+1] := 0X; find.len := i+1;
  149.                         name[len] := 0X;    (* delete extension, try with trimmed name *)
  150.                         IF Try() THEN COPY(extName, name)    (* use extended name *)
  151.                         ELSE COPY(s.s, name)    (* use original name with empty text *)
  152.                         END
  153.                     END
  154.                 END
  155.             END
  156.         END
  157.     END OpenText;
  158.     PROCEDURE Show(f: TextFrames.Frame; pos: LONGINT);    
  159.         VAR end, delta: LONGINT;
  160.     BEGIN
  161.         delta := 200; end := TextFrames.Pos(f, f.X+f.W, f.Y);
  162.         WHILE ((f.org > pos) OR (pos >= end)) & (f.org # end) DO
  163.             TextFrames.Show(f, pos-delta); DEC(delta, 20);
  164.             end := TextFrames.Pos(f, f.X+f.W, f.Y)
  165.         END
  166.     END Show;
  167.     PROCEDURE GetOptions(VAR s: Texts.Scanner; VAR options: ARRAY OF CHAR);    
  168.         VAR pos: LONGINT; i: INTEGER; ch: CHAR; r: Texts.Reader;
  169.     BEGIN
  170.         IF (s.class # Texts.Char) OR (s.c # OptionChar1) & (s.c # OptionChar2) THEN options[0] := 0X
  171.         ELSE
  172.             pos := Texts.Pos(s);
  173.             options[0] := s.c; ch := s.nextCh; i := 1; r := s;
  174.             WHILE ((ch >= "0") & (ch <= "9") OR (ch >= "a") & (ch <= "z")) & (i < LEN(options)-1) DO
  175.                 options[i] := ch; INC(i); Texts.Read(r, ch)
  176.             END;
  177.             options[i] := 0X; pos := pos+(i-1);
  178.             WHILE Texts.Pos(s) < pos DO Texts.Scan(s) END; Texts.Scan(s)
  179.         END
  180.     END GetOptions;
  181.     PROCEDURE MenuFrame(name, menu: ARRAY OF CHAR; line: INTEGER): TextFrames.Frame;    
  182.         (* open MenuText and if existant get lineth textline (counting starts with 0) as menuline *)
  183.         VAR mf: TextFrames.Frame; buf: Texts.Buffer; t: Texts.Text; r: Texts.Reader; start, end: LONGINT; ch: CHAR;
  184.     BEGIN
  185.         IF Files.Old(MenuText) = NIL THEN mf := TextFrames.NewMenu(name, menu)
  186.         ELSE
  187.             mf := TextFrames.NewMenu(name, "");
  188.             NEW(t); Texts.Open(t, MenuText);
  189.             Texts.OpenReader(r, t, 0);
  190.             REPEAT    (* skip line lines *)
  191.                 start := Texts.Pos(r);
  192.                 REPEAT Texts.Read(r, ch) UNTIL r.eot OR (ch = 0DX);
  193.                 DEC(line)
  194.             UNTIL line < 0;
  195.             IF r.eot THEN end := t.len ELSE end := Texts.Pos(r)-1 END;
  196.             NEW(buf); Texts.OpenBuf(buf); Texts.Save(t, start, end, buf); Texts.Append(mf.text, buf)
  197.         END;
  198.         RETURN mf
  199.     END MenuFrame;
  200.     PROCEDURE NoNotify(t: Texts.Text; op: INTEGER; beg, end: LONGINT);
  201.     END NoNotify;
  202.     PROCEDURE BackRead(VAR r: Texts.Reader; t: Texts.Text; VAR ch: CHAR);    
  203.         VAR p: LONGINT;
  204.     BEGIN
  205.         p := Texts.Pos(r);
  206.         IF p > 0 THEN Texts.OpenReader(r, t, p-1); Texts.Read(r, ch); Texts.OpenReader(r, t, p-1)
  207.         ELSE ch := 0X
  208.         END
  209.     END BackRead;
  210.     PROCEDURE InWordSet(ch: CHAR): BOOLEAN;    
  211.     BEGIN
  212.         RETURN (("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "Z")
  213.             OR ("a" <= ch) & (ch <= "z") OR (80X <= ch) & (ch <= 95X))
  214.     END InWordSet;
  215.     PROCEDURE InNameSet(ch: CHAR): BOOLEAN;    
  216.     BEGIN RETURN (ch = ".") OR InWordSet(ch)
  217.     END InNameSet;
  218.     PROCEDURE Find(t: Texts.Text; beg: LONGINT; VAR end: LONGINT);    
  219.         VAR r: Texts.Reader; i, j, b, e: INTEGER; ch: CHAR; ref: ARRAY MaxPat OF CHAR;    (* ref [b..e) is readback buffer *)
  220.     BEGIN
  221.         Texts.OpenReader(r, t, beg); Texts.Read(r, ch); i := 0; ref[0] := ch; j := 0; b := 0; e := 1;
  222.         WHILE ~r.eot & (i < find.len) DO
  223.             IF (find.buf[i] = ch) OR (i = find.len-1) & (ch = "-") THEN    (* detect Name* and Name- *)
  224.                 INC(i); j := (j + 1) MOD MaxPat
  225.             ELSE i := 0; b := (b + 1) MOD MaxPat; j := b
  226.             END;
  227.             IF j # e THEN ch := ref[j]
  228.             ELSE Texts.Read(r, ch); ref[j] := ch; e := (e + 1) MOD MaxPat; INC(beg)
  229.             END
  230.         END;
  231.         IF i = find.len THEN end := beg ELSE end := -1 END
  232.     END Find;
  233.     PROCEDURE WordBounds(t: Texts.Text; VAR beg, end: LONGINT; name: BOOLEAN);    
  234.         VAR r: Texts.Reader; ch: CHAR;
  235.     BEGIN
  236.         Texts.OpenReader(r, t, beg);
  237.         REPEAT Texts.Read(r, ch)
  238.         UNTIL r.eot OR (name & ~InNameSet(ch)) OR (~name & ~InWordSet(ch));
  239.         IF r.eot THEN end := t.len ELSE end := Texts.Pos(r)-1 END;
  240.         Texts.OpenReader(r, t, beg);
  241.         REPEAT BackRead(r, t, ch)
  242.         UNTIL (name & ~InNameSet(ch)) OR (~name & ~InWordSet(ch));
  243.         IF ch = 0X THEN beg := 0 ELSE beg := Texts.Pos(r)+1 END
  244.     END WordBounds;
  245.     PROCEDURE EndOfLine(f: TextFrames.Frame; VAR loc: TextFrames.Location; org: LONGINT; VAR end: LONGINT);
  246.     BEGIN
  247.         WHILE (end < f.text.len) & (loc.org <= org) DO INC(end, 30); TextFrames.LocatePos(f, end, loc) END;
  248.         IF (end >= f.text.len) & (loc.org <= org) THEN end := f.text.len
  249.         ELSE WHILE loc.org > org DO end := loc.org; TextFrames.LocatePos(f, end-1, loc) END
  250.         END
  251.     END EndOfLine;
  252.     PROCEDURE TrackSelection(f: TextFrames.Frame; VAR x, y: INTEGER; VAR keysum: SET);    
  253.         VAR
  254.             keys: SET;
  255.             beg, end, begW, endW, begN, endN, pos: LONGINT; loc, loc1: TextFrames.Location;
  256.             v: Viewers.Viewer; upper: TextFrames.Frame;
  257.             r: Texts.Reader; ch: CHAR;
  258.     BEGIN
  259.         v := Viewers.This(f.X, f.Y); v := v.next(Viewers.Viewer);
  260.         IF (v.dsc # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
  261.             upper := v.dsc.next(TextFrames.Frame);
  262.             IF upper.hasSel & (upper.text = f.text) THEN
  263.                 TextFrames.LocateLine(upper, upper.bot, loc);
  264.                 IF (upper.selbeg.pos < loc.org) & (upper.org < upper.selend.pos)
  265.                         & (upper.selbeg.pos <= TextFrames.Pos(f, x, y)) THEN
  266.                     TextFrames.SetSelection(f, upper.selbeg.pos, TextFrames.Pos(f, x, y)+1)
  267.                 ELSE TextFrames.RemoveSelection(upper); upper := NIL
  268.                 END
  269.             ELSE upper := NIL
  270.             END
  271.         ELSE upper := NIL
  272.         END;
  273.         IF upper = NIL THEN
  274.             pos := TextFrames.Pos(f, x, y);
  275.             IF f.hasSel & (Oberon.Time() < f.time+Delay) THEN
  276.                 beg := f.selbeg.pos; end := f.selend.pos;
  277.                 IF (beg+1 = end) & (pos = beg) THEN    (* one char selected, mouse on same character *)
  278.                     TextFrames.LocatePos(f, beg, loc); TextFrames.LocatePos(f, end, loc1);
  279.                     Texts.OpenReader(r, f.text, beg); Texts.Read(r, ch);
  280.                     IF (end = f.text.len) OR (loc.org # loc1.org) OR ~InNameSet(ch) THEN    (* extend to whole line *)
  281.                         EndOfLine(f, loc1, loc.org, end);
  282.                         TextFrames.SetSelection(f, loc.org, end)
  283.                     ELSE    (* (end # f.text.len) & (loc.org = loc1.org) & InNameSet(ch) *)
  284.                         begW := pos; endW := pos+1; WordBounds(f.text, begW, endW, ch = ".");
  285.                         begN := pos; endN := pos+1; WordBounds(f.text, begN, endN, TRUE);
  286.                         IF (begW = beg) & (endW = end) THEN
  287.                             IF (begN = beg) & (endN = end) THEN
  288.                                 (* single char InNameSet -> select line *)
  289.                                 EndOfLine(f, loc1, loc.org, end);
  290.                                 TextFrames.SetSelection(f, loc.org, end)
  291.                             ELSE TextFrames.SetSelection(f, begN, endN)    (* name *)
  292.                             END
  293.                         ELSE TextFrames.SetSelection(f, begW, endW)    (* word *)
  294.                         END
  295.                     END
  296.                 ELSIF (beg <= pos) & (pos < end) THEN    (* mouse within selection *)
  297.                     TextFrames.LocatePos(f, beg, loc); TextFrames.LocatePos(f, end-1, loc1);
  298.                     IF loc.org = loc1.org THEN    (* selection is at most one line *)
  299.                         begW := pos; endW := pos+1; WordBounds(f.text, begW, endW, FALSE);
  300.                         begN := pos; endN := pos+1; WordBounds(f.text, begN, endN, TRUE);
  301.                         IF (begW = beg) & (endW = end) & ((begN < beg) OR (end < endN)) THEN
  302.                             (* word selected -> extend to name *)
  303.                             TextFrames.SetSelection(f, begN, endN)
  304.                         ELSE    (* name selected -> extend to line *)
  305.                             endN := loc1.pos; EndOfLine(f, loc1, loc.org, endN);
  306.                             IF (loc.org # beg) OR (endN # end) THEN TextFrames.SetSelection(f, loc.org, endN)
  307.                             ELSE TextFrames.SetSelection(f, pos, pos+1)    (*  select single char *)
  308.                             END
  309.                         END
  310.                     ELSE TextFrames.SetSelection(f, pos, pos+1)    (* not same line -> select single char *)
  311.                     END
  312.                 ELSE TextFrames.SetSelection(f, pos, pos+1)    (* not within selection -> select single char *)
  313.                 END
  314.             ELSE TextFrames.SetSelection(f, pos, pos+1)    (* no selection or time out -> select single char *)
  315.             END;    (* f.hasSel & ... *)
  316.             end := f.selend.pos
  317.         ELSE end := upper.selbeg.pos
  318.         END;    (* upper = NIL *)
  319.         REPEAT
  320.             Input.Mouse(keys, x, y); keysum := keysum+keys; Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y);
  321.             pos := TextFrames.Pos(f, x, y)+1;
  322.             IF f.hasSel THEN
  323.                 IF pos >= end THEN TextFrames.SetSelection(f, f.selbeg.pos, pos);
  324.                     IF upper # NIL THEN
  325.                         TextFrames.SetSelection(upper, upper.selbeg.pos, pos); upper.selend.pos := f.selend.pos
  326.                     END
  327.                 END
  328.             ELSE TextFrames.SetSelection(f, TextFrames.Pos(f, x, y), TextFrames.Pos(f, x, y)+1)
  329.             END
  330.         UNTIL keys = {};
  331.         IF upper # NIL THEN f.selbeg.pos := upper.selbeg.pos END
  332.     END TrackSelection;
  333.     PROCEDURE CaretVisible(f: TextFrames.Frame; pos: LONGINT): BOOLEAN;    
  334.     BEGIN RETURN f.hasCar & (f.carloc.y >= f.bot) & (f.carloc.pos = pos)
  335.     END CaretVisible;
  336.     PROCEDURE MoveTextStretch(from: Texts.Text; to: TextFrames.Frame; beg, end, pos: LONGINT);    
  337.         VAR len: LONGINT;
  338.     BEGIN
  339.         (* only if other text or target pos not within selection *)
  340.         IF ((from # to.text) OR (pos < beg) OR (end < pos)) THEN
  341.             len := end-beg;
  342.             IF (from = to.text) & (end < pos) THEN DEC(pos, len) END;    (* dec caret pos by length of sel *)
  343.             Texts.Save(from, beg, end, wr.buf); Texts.Delete(from, beg, end); Texts.Insert(to.text, pos, wr.buf);
  344.             TextFrames.SetCaret(to, pos+len);
  345.             IF CaretVisible(to, pos+len) THEN TextFrames.SetSelection(to, pos, pos+len) END
  346.         END
  347.     END MoveTextStretch;
  348.     PROCEDURE MoveSelection(f: TextFrames.Frame; x, y: INTEGER; keySum: SET);    
  349.         VAR keys: SET; v: Viewers.Viewer; target: TextFrames.Frame;
  350.     BEGIN
  351.         REPEAT Input.Mouse(keys, x, y); keySum := keySum+keys; Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  352.         UNTIL (keys = {}) OR (keySum # {MM});
  353.         IF (keys # {}) & (keySum = {MM, ML}) THEN
  354.             v := Viewers.This(x, y);
  355.             IF (v.dsc # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
  356.                 target := v.dsc.next(TextFrames.Frame);
  357.                 Oberon.PassFocus(v); TextFrames.TrackCaret(target, x, y, keySum);
  358.                 IF keySum = {MM, ML} THEN
  359.                     MoveTextStretch(f.text, target, f.selbeg.pos, f.selend.pos, target.carloc.pos)
  360.                 END
  361.             END
  362.         END
  363.     END MoveSelection;
  364.     PROCEDURE OpenCall(f: TextFrames.Frame; x, y: INTEGER; pos: LONGINT);    
  365.         VAR s: Texts.Scanner; par: Oberon.ParList; loc: TextFrames.Location; beg, end, newPos: LONGINT; res: INTEGER;
  366.     BEGIN
  367.         TextFrames.LocateChar(f, x, y, loc); newPos := loc.pos;
  368.         REPEAT beg := newPos; WordBounds(f.text, beg, end, TRUE); DEC(newPos)
  369.         UNTIL (beg < end) OR (newPos < pos);
  370.         IF beg < end THEN
  371.             Texts.OpenScanner(s, f.text, beg); Texts.Scan(s);
  372.             IF (s.line = 0) & (s.class = Texts.Name) THEN
  373.                 NEW(par); par.frame := f; par.text := f.text; par.pos := beg;
  374.                 Oberon.Call(OpenCmd, par, FALSE, res)
  375.             END
  376.         END
  377.     END OpenCall;
  378.     PROCEDURE HandleCall(f: TextFrames.Frame; pos: LONGINT; new: BOOLEAN);    
  379.         VAR s: Texts.Scanner; par: Oberon.ParList; res, i, j: INTEGER;
  380.     BEGIN
  381.         Texts.OpenScanner(s, f.text, pos); Texts.Scan(s);
  382.         IF (s.class = Texts.Name) & (s.line = 0) THEN
  383.             i := 0; WHILE (i < s.len) & (s.s[i] # ".") DO INC(i) END;
  384.             j := i+1; WHILE (j < s.len) & (s.s[j] # ".") DO INC(j) END;
  385.             IF (j >= s.len) & (s.s[i] = ".") THEN
  386.                 NEW(par); par.frame := f; par.text := f.text; par.pos := pos+s.len;
  387.                 Oberon.Call(s.s, par, new, res);
  388.                 IF res > 0 THEN    (* not-object model error messages *) 
  389.                     IF res = 1 THEN Str(Modules.importing); Str(" not found")
  390.                     ELSIF res = 2 THEN Str(Modules.importing); Str(" not an obj-file")
  391.                     ELSIF res = 3 THEN Str(Modules.importing); Str(" imports "); Str(Modules.imported); Str(" with bad key")
  392.                     ELSIF res = 4 THEN Str(Modules.importing); Str(" corrupted obj file")
  393.                     ELSIF res = 5 THEN Str(s.s); Str(" command not found")
  394.                     ELSIF res = 6 THEN Str(Modules.importing); Str(" has too many imports")
  395.                     ELSIF res = 7 THEN Str(Modules.importing); Str(" not enough space")
  396.                     END;
  397.                     Ln
  398.                 ELSIF res < 0 THEN
  399.                     INC(i); WHILE i < s.len DO Ch(s.s[i]); INC(i) END;
  400.                     Str(" not found"); Ln
  401.                 END
  402.                 IF res > 0 THEN    (* object model error messages *)
  403.                     IF res = 1 THEN Str(Modules.importing); Str(" module not found")
  404.                     ELSIF res = 2 THEN Str(Modules.importing); Str(" not an obj-file")
  405.                     ELSIF res = 3 THEN
  406.                         Str(Modules.importing); Str(" imports "); Str(Modules.objmode); Ch(" ");
  407.                         Str(Modules.imported); Ch(".");
  408.                         Str(Modules.object); Str(" with bad fingerprint")
  409.                     ELSIF res = 4 THEN Str(Modules.importing); Str(" corrupted obj-file")
  410.                     ELSIF res = 5 THEN Str(s.s); Str(" command not found")
  411.                     ELSIF res = 7 THEN Str(Modules.importing); Str(" not enough space")
  412.                     ELSIF res = 10 THEN
  413.                         Str(Modules.importing); Str(" imports "); Str(Modules.objmode); Ch(" ");
  414.                         Str(Modules.imported); Ch(".");
  415.                         Str(Modules.object); Str(", not found")
  416.                     ELSIF res = 11 THEN Str(Modules.importing); Str(" too many open files")
  417.                     END;
  418.                     Ln
  419.                 ELSIF res < 0 THEN
  420.                     INC(i); WHILE i < s.len DO Ch(s.s[i]); INC(i) END;
  421.                     Str(" not found"); Ln
  422.                 END
  423.             END
  424.         END
  425.     END HandleCall;
  426.     (* Error Element *)
  427.     PROCEDURE ElemWidth(e: Elem): INTEGER;    
  428.         VAR pat: Display.Pattern; i, px, dx, x, y, w, h: INTEGER; str: LongName;
  429.     BEGIN
  430.         i := 0; px := 0;
  431.         IF e.wide THEN COPY(e.msg, str) ELSE COPY(e.num, str) END;
  432.         WHILE str[i] # 0X DO
  433.             Display.GetChar(errFnt.raster, str[i], dx, x, y, w, h, pat); INC(px, dx); INC(i)
  434.         END;
  435.         RETURN px+6
  436.     END ElemWidth;
  437.     PROCEDURE UpdateErr(e: Elem);    
  438.         VAR t: Texts.Text;
  439.     BEGIN    (* precondition: e.pos is correct *)
  440.         t := Texts.ElemBase(e); t.notify(t, Texts.replace, e.pos, e.pos+1)
  441.     END UpdateErr;
  442.     PROCEDURE ShowErrMsg(e: Elem; col: SHORTINT; x0, y0, dw: INTEGER);    
  443.         VAR
  444.             pat: Display.Pattern; i, px, rm, dx, x, y, w, h: INTEGER;
  445.             ch: CHAR; str: LongName;
  446.     BEGIN
  447.         IF e.wide THEN COPY(e.msg, str) ELSE COPY(e.num, str) END;
  448.         i := 0; px := x0+3; rm := x0+dw-3; INC(y0, 2);
  449.         LOOP
  450.             ch := str[i]; INC(i);
  451.             IF ch = 0X THEN EXIT END;
  452.             Display.GetChar(errFnt.raster, ch, dx, x, y, w, h, pat);
  453.             IF px+dx > rm THEN EXIT END;
  454.             Display.CopyPattern(col, pat, px+x, y0+y, Display.invert); INC(px, dx)
  455.         END
  456.     END ShowErrMsg;
  457.     PROCEDURE DeleteErrElems(t: Texts.Text);    
  458.         VAR r: Texts.Reader; pos: LONGINT;
  459.     BEGIN
  460.         Texts.OpenReader(r, t, 0); Texts.ReadElem(r);
  461.         WHILE r.elem # NIL DO
  462.             IF r.elem IS Elem THEN pos := Texts.Pos(r); Texts.Delete(t, pos-1, pos); Texts.OpenReader(r, t, pos) END;
  463.             Texts.ReadElem(r)
  464.         END
  465.     END DeleteErrElems;
  466.     PROCEDURE ElemHandle(e: Texts.Elem; VAR msg: Texts.ElemMsg);    
  467.         VAR copy: Elem; w, h: INTEGER; keys, keySum: SET;
  468.         PROCEDURE Expand(el: Elem);    
  469.             VAR s: Texts.Scanner; n: INTEGER; ch: CHAR;
  470.         BEGIN
  471.             IF el.msg[0] = 0X THEN
  472.                 Texts.OpenScanner(s, errT, 0);
  473.                 REPEAT
  474.                     s.line := 0;
  475.                     REPEAT Texts.Scan(s) UNTIL s.eot OR (s.line # 0)
  476.                 UNTIL s.eot OR (s.class = Texts.Int) & (s.i = el.err);
  477.                 IF ~s.eot THEN
  478.                     Texts.Read(s, ch); n := 0;
  479.                     WHILE ~s.eot & (ch # CR) & (n+1 < LEN(el.msg)) DO el.msg[n] := ch; INC(n); Texts.Read(s, ch) END;
  480.                     el.msg[n] := 0X
  481.                 END
  482.             END;
  483.             el.wide := TRUE;
  484.             el.W := LONG(ElemWidth(el))*TextFrames.Unit
  485.         END Expand;
  486.     BEGIN
  487.         WITH e: Elem DO
  488.             WITH msg: TextFrames.DisplayMsg DO
  489.                 IF ~msg.prepare THEN
  490.                     w := SHORT(e.W DIV TextFrames.Unit); h := SHORT(e.H DIV TextFrames.Unit);
  491.                     Display.ReplConst(Display.white, msg.X0+1, msg.Y0+2, w-2, h, Display.replace);
  492.                     ShowErrMsg(e, msg.col, msg.X0, msg.Y0+2, w)
  493.                 END
  494.             | msg: TextFrames.TrackMsg DO    (* a mouse click hit the element *)
  495.                 IF msg.keys = {MM} THEN
  496.                     w := SHORT(e.W DIV TextFrames.Unit); h := SHORT(e.H DIV TextFrames.Unit);
  497.                     Oberon.RemoveMarks(msg.X0, msg.Y0, w, h);
  498.                     Display.ReplConst(Display.white, msg.X0+2, msg.Y0+3, w-4, h-2, Display.invert);
  499.                     keySum := msg.keys;
  500.                     REPEAT
  501.                         Input.Mouse(keys, msg.X, msg.Y); keySum := keySum+keys;
  502.                         Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, msg.X, msg.Y)
  503.                     UNTIL keys = {};
  504.                     Display.ReplConst(Display.white, msg.X0+2, msg.Y0+3, w-4, h-2, Display.invert);
  505.                     e.pos := msg.pos;
  506.                     IF keySum = {MM} THEN    (* expand/reduce element *)
  507.                         IF ~e.wide THEN Expand(e)
  508.                         ELSE e.wide := FALSE; e.W := LONG(ElemWidth(e))*TextFrames.Unit
  509.                         END;
  510.                         UpdateErr(e)
  511.                     END;
  512.                     msg.keys := {}
  513.                 END
  514.             | msg: Texts.CopyMsg  DO    (* copy element *)
  515.                 NEW(copy); Texts.CopyElem(e, copy); copy.err := e.err; copy.pos := e.pos; copy.wide := e.wide;
  516.                 copy.num := e.num; copy.msg := e.msg; msg.e := copy
  517.             ELSE
  518.             END
  519.         END
  520.     END ElemHandle;
  521.     PROCEDURE InsertErrAt(t: Texts.Text; pos: LONGINT; err: INTEGER);    
  522.         VAR e: Elem; h: ARRAY 8 OF CHAR; j, k: INTEGER;
  523.     BEGIN
  524.         NEW(e); e.H := 3*TextFrames.mm; e.handle := ElemHandle;
  525.         e.err := err; e.msg := ""; e.wide := FALSE;
  526.         k := 0; REPEAT h[k] := CHR(err MOD 10 + ORD("0")); err := err DIV 10; INC(k) UNTIL err = 0;
  527.         j := 0; REPEAT DEC(k); e.num[j] := h[k]; INC(j) UNTIL k = 0;
  528.         e.num[j] := 0X;
  529.         e.W := LONG(ElemWidth(e))*TextFrames.Unit;
  530.         Texts.WriteElem(wr, e); Texts.Insert(t, pos, wr.buf)
  531.     END InsertErrAt;
  532.     PROCEDURE MarkErrors(f: TextFrames.Frame; t: Texts.Text; beg: LONGINT);    
  533.         VAR s: Texts.Scanner; pos, delta: LONGINT; err: INTEGER; log: Texts.Text; error: BOOLEAN;
  534.     BEGIN
  535.         DeleteErrElems(f.text);
  536.         log := Oberon.Log; pos := log.len;
  537.         Texts.OpenScanner(s, log, beg); REPEAT Texts.Scan(s) UNTIL s.eot OR (s.class = Texts.Name) & (s.s = "pos");
  538.         IF (s.class = Texts.Name) & (s.s = "pos") THEN
  539.             delta := 0;
  540.             LOOP
  541.                 s.line := 0;
  542.                 REPEAT Texts.Scan(s) UNTIL s.eot OR (s.line # 0) OR (s.class = Texts.Int);
  543.                 IF s.eot OR (s.line # 0) THEN EXIT END;
  544.                 pos := s.i;
  545.                 Texts.Scan(s); error := s.s = "err";
  546.                 REPEAT Texts.Scan(s) UNTIL s.eot OR (s.line # 0) OR (s.class = Texts.Int);
  547.                 IF s.eot OR (s.line # 0) THEN EXIT END;
  548.                 err := SHORT(s.i);
  549.                 (* display errors, but warnings only if it's the Analyzer *)
  550.                 IF error OR (compiler = "Analyzer.Analyze") THEN InsertErrAt(t, pos+delta, err); INC(delta) END;
  551.                 REPEAT Texts.Scan(s) UNTIL s.eot OR (s.line # 0)
  552.             END
  553.         END
  554.     END MarkErrors;
  555.     PROCEDURE ErrCheck(e: Texts.Elem): BOOLEAN;    
  556.     BEGIN RETURN e IS Elem
  557.     END ErrCheck;
  558.     (* Handler *)
  559.     PROCEDURE Handle(f: Display.Frame; VAR msg: Display.FrameMsg);    
  560.         VAR
  561.             tf, ff: TextFrames.Frame;
  562.             t, sel: Texts.Text; loc: TextFrames.Location; copyOver: Oberon.CopyOverMsg;
  563.             r: Texts.Reader; handled: BOOLEAN; ch: CHAR; x, y: INTEGER;
  564.             pos, beg, end, len, time: LONGINT; keySum: SET;
  565.         PROCEDURE PartialFolds(text: Texts.Text; b, e: LONGINT): BOOLEAN;
  566.             CONST leftMode = {FoldElems.colLeft, FoldElems.expLeft, FoldElems.tempLeft, FoldElems.findLeft};
  567.             VAR level: INTEGER;
  568.         BEGIN
  569.             level := 0; Texts.OpenReader(r, text, b); Texts.ReadElem(r);
  570.             WHILE (r.elem # NIL) & (Texts.Pos(r) <= e) DO
  571.                 IF r.elem IS FoldElems.Elem THEN
  572.                     IF r.elem(FoldElems.Elem).mode IN leftMode THEN INC(level) ELSE DEC(level) END
  573.                 END;
  574.                 Texts.ReadElem(r)
  575.             END;
  576.             RETURN level # 0
  577.         END PartialFolds;
  578.         PROCEDURE ThisSubFrame(x, y: INTEGER): Display.Frame;
  579.             VAR sf: Display.Frame;
  580.         BEGIN
  581.             sf := f.dsc;
  582.             WHILE (sf # NIL) & ((x < sf.X) OR (x >= sf.X+sf.W) OR (y < sf.Y) OR (y >= sf.Y+sf.H)) DO sf := sf.next END;
  583.             RETURN sf
  584.         END ThisSubFrame;
  585.     BEGIN
  586.         tf := f(TextFrames.Frame);
  587.         IF keyHandle # NIL THEN keyHandle(tf, msg) END;
  588.         t := tf.text; handled := TRUE;
  589.         WITH msg: Oberon.InputMsg DO
  590.             IF (msg.id = Oberon.track) & (msg.X >= tf.X+tf.barW) & (ThisSubFrame(msg.X, msg.Y) = NIL) THEN
  591.                 IF ML IN msg.keys THEN
  592.                     Oberon.PassFocus(Viewers.This(tf.X, tf.Y)); TextFrames.TrackCaret(tf, x, y, keySum);
  593.                     IF (keySum = {ML, MM}) & tf.hasCar THEN
  594.                         Oberon.GetSelection(sel, beg, end, time);
  595.                         IF time >= 0 THEN
  596.                             Texts.Save(sel, beg, end, wr.buf); len := end-beg; pos := tf.carloc.pos;
  597.                             Texts.Insert(tf.text, pos, wr.buf); TextFrames.SetCaret(tf, pos+len);
  598.                             IF CaretVisible(tf, pos+len) THEN TextFrames.SetSelection(tf, pos, pos+len) END
  599.                         END
  600.                     ELSIF (keySum = {ML, MR}) & tf.hasCar & (tf.carloc.pos < tf.text.len) THEN
  601.                         Oberon.GetSelection(sel, beg, end, time);
  602.                         IF time >= 0 THEN
  603.                             Texts.OpenReader(r, tf.text, tf.carloc.pos); Texts.Read(r, ch);
  604.                             Texts.ChangeLooks(sel, beg, end, {0, 1, 2}, r.fnt, r.col, r.voff)
  605.                         END
  606.                     END
  607.                 ELSIF MM IN msg.keys THEN
  608.                     x := msg.X; y := msg.Y; pos := TextFrames.Pos(tf, x, y);
  609.                     IF tf.hasSel & (tf.selbeg.pos <= pos) & (pos < tf.selend.pos) THEN MoveSelection(tf, x, y, msg.keys)
  610.                     ELSE
  611.                         Texts.OpenReader(r, t, pos); Texts.ReadElem(r);
  612.                         IF (r.elem = NIL) OR (Texts.Pos(r) # pos+1) THEN    (* no elem at this position *)
  613.                             keySum := msg.keys; TextFrames.TrackWord(tf, x, y, pos, keySum);
  614.                             IF (keySum = {MM}) OR (keySum = {MM, ML}) THEN HandleCall(tf, pos, keySum = {MM, ML})
  615.                             ELSIF keySum = {MM, MR} THEN OpenCall(tf, x, y, pos)
  616.                             END
  617.                         ELSE handled := FALSE
  618.                         END
  619.                     END
  620.                 ELSIF MR IN msg.keys THEN
  621.                     TrackSelection(tf, msg.X, msg.Y, msg.keys);
  622.                     IF (msg.keys = {MM, MR}) & tf.hasSel & ~PartialFolds(tf.text, tf.selbeg.pos, tf.selend.pos) THEN
  623.                         copyOver.text := tf.text; copyOver.beg := tf.selbeg.pos; copyOver.end := tf.selend.pos;
  624.                         len := copyOver.end-copyOver.beg;
  625.                         IF (Oberon.FocusViewer IS MenuViewers.Viewer) & (Oberon.FocusViewer.dsc.next # NIL)
  626.                                 & (Oberon.FocusViewer(MenuViewers.Viewer).dsc.next IS TextFrames.Frame) THEN
  627.                             ff := Oberon.FocusViewer.dsc.next(TextFrames.Frame); pos := ff.carloc.pos
  628.                         ELSE ff := NIL
  629.                         END;
  630.                         Oberon.FocusViewer.handle(Oberon.FocusViewer, copyOver);
  631.                         IF (ff # NIL) & CaretVisible(ff, pos+len) THEN TextFrames.SetSelection(ff, pos, pos+len) END
  632.                     ELSIF (msg.keys = {ML, MR}) & tf.hasSel & ~PartialFolds(tf.text, tf.selbeg.pos, tf.selend.pos) THEN
  633.                         Oberon.PassFocus(Viewers.This(tf.X, tf.Y));
  634.                         Texts.Delete(tf.text, tf.selbeg.pos, tf.selend.pos); TextFrames.SetCaret(tf, tf.selbeg.pos)
  635.                     END
  636.                 ELSE handled := FALSE
  637.                 END
  638.             ELSIF (msg.id = Oberon.consume) & tf.hasCar THEN
  639.                 loc := tf.carloc; pos := loc.pos;
  640.                 CASE msg.ch OF
  641.                 | CR: msg.ch := LF; handled := FALSE    (* switch CR <-> LF *)
  642.                 | LF: msg.ch := CR; handled := FALSE
  643.                 | BS, CtrlD: IF pos < t.len THEN Texts.Delete(t, pos, pos+1); TextFrames.SetCaret(tf, pos) END
  644.                 | DnArrow, CtrlN:
  645.                     IF loc.y-loc.dy  <= tf.Y+tf.bot THEN    (* at bottom of f *)
  646.                         TextFrames.Show(tf, TextFrames.Pos(tf, loc.x, tf.Y+tf.bot+tf.H-tf.top));
  647.                         TextFrames.SetCaret(tf, TextFrames.Pos(tf, loc.x+1, loc.y))
  648.                     ELSE
  649.                         y := loc.y-loc.dy;
  650.                         REPEAT pos := TextFrames.Pos(tf, loc.x+1, y); DEC(y)
  651.                         UNTIL (pos # loc.pos) OR (pos >= t.len) OR (y <= tf.Y+tf.bot);
  652.                         TextFrames.SetCaret(tf, pos)
  653.                     END
  654.                 | UpArrow, CtrlP:
  655.                     IF loc.org = tf.org THEN    (* top of frame *)
  656.                         IF tf.org > 0 THEN
  657.                             pos := tf.org-1; TextFrames.Show(tf, pos);
  658.                             TextFrames.SetCaret(tf, TextFrames.Pos(tf, loc.x+1, tf.Y+tf.H))
  659.                         END
  660.                     ELSE    (* not at top *)
  661.                         y := loc.y+loc.dy;
  662.                         REPEAT pos := TextFrames.Pos(tf, loc.x+1, y); INC(y)
  663.                         UNTIL (pos # loc.pos) OR (y >= tf.Y+tf.H);
  664.                         TextFrames.SetCaret(tf, pos)
  665.                     END
  666.                 | CtrlT:
  667.                     IF pos > 1 THEN    (* exchange this with previous char *)
  668.                         Texts.Save(t, pos-2, pos-1, wr.buf);
  669.                         Texts.Delete(t, pos-2, pos-1); Texts.Insert(t, pos-1, wr.buf);
  670.                         TextFrames.SetCaret(tf, pos)
  671.                     END
  672.                 | CtrlF:
  673.                     IF pos < t.len THEN    (* move one word forward *)
  674.                         Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
  675.                         WHILE ~r.eot & (ch <= " ") & (ch # Texts.ElemChar) DO Texts.Read(r, ch) END;
  676.                         IF r.eot THEN pos := t.len
  677.                         ELSE
  678.                             IF ~InWordSet(ch) THEN pos := Texts.Pos(r)
  679.                             ELSE
  680.                                 REPEAT Texts.Read(r, ch) UNTIL r.eot OR ~InWordSet(ch);
  681.                                 IF r.eot THEN pos := t.len ELSE pos := Texts.Pos(r)-1 END;
  682.                                 TextFrames.LocatePos(tf, pos, loc);
  683.                                 IF loc.y <= tf.Y THEN TextFrames.Show(tf, pos) END;    (* at bottom of f *)
  684.                             END
  685.                         END;
  686.                         TextFrames.SetCaret(tf, pos)
  687.                     END
  688.                 | CtrlB:
  689.                     IF pos > 0 THEN    (* move one word backward *)
  690.                         Texts.OpenReader(r, t, pos);
  691.                         REPEAT BackRead(r, t, ch) UNTIL (Texts.Pos(r) = 0) OR (ch > " ") OR (ch = Texts.ElemChar);
  692.                         IF Texts.Pos(r) = 0 THEN pos := 0
  693.                         ELSE
  694.                             IF ~InWordSet(ch) THEN pos := Texts.Pos(r)
  695.                             ELSE
  696.                                 REPEAT BackRead(r, t, ch) UNTIL (Texts.Pos(r) = 0) OR ~InWordSet(ch);
  697.                                 IF Texts.Pos(r) = 0 THEN pos := 0 ELSE pos := Texts.Pos(r)+1 END
  698.                             END
  699.                         END;
  700.                         IF pos < tf.org THEN TextFrames.Show(tf, pos) END;
  701.                         TextFrames.SetCaret(tf, pos)
  702.                     END
  703.                 | CtrlE:
  704.                     IF pos < t.len THEN    (* move to end of (next) line *)
  705.                         Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
  706.                         IF ~r.eot & (ch = CR) THEN Texts.Read(r, ch) END;
  707.                         WHILE ~r.eot & (ch # CR) DO Texts.Read(r, ch) END;
  708.                         IF r.eot THEN TextFrames.SetCaret(tf, t.len) ELSE TextFrames.SetCaret(tf, Texts.Pos(r)-1) END
  709.                     END
  710.                 | CtrlW:
  711.                     IF pos > 0 THEN    (* move to beginning of (previous) line *)
  712.                         IF pos = loc.org THEN TextFrames.LocatePos(tf, pos-1, loc) END;
  713.                         TextFrames.SetCaret(tf, loc.org)
  714.                     END
  715.                 | CtrlK:    (* delete to end of line *)
  716.                     Texts.OpenReader(r, t, pos);
  717.                     REPEAT Texts.Read(r, ch) UNTIL r.eot OR (ch = CR);
  718.                     IF Texts.Pos(r) = pos+1 THEN Texts.Delete(t, pos, pos+1) ELSE Texts.Delete(t, pos, Texts.Pos(r)-1) END;
  719.                     TextFrames.SetCaret(tf, pos)
  720.                 | CtrlX:    (* move selection to caret position *)
  721.                     Oberon.GetSelection(sel, beg, end, time);
  722.                     IF time >= 0 THEN MoveTextStretch(sel, tf, beg, end, pos) END
  723.                 | CtrlZ:
  724.                     IF pos < t.len  THEN    (* delete forward to non-char *)
  725.                         Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
  726.                         WHILE ~r.eot & (ch <= " ") & (ch # Texts.ElemChar) DO Texts.Read(r, ch) END;
  727.                         IF r.eot THEN end := t.len
  728.                         ELSE
  729.                             IF ~InWordSet(ch) THEN end := Texts.Pos(r)
  730.                             ELSE
  731.                                 REPEAT Texts.Read(r, ch) UNTIL r.eot OR ~InWordSet(ch);
  732.                                 IF r.eot THEN end := t.len ELSE end := Texts.Pos(r)-1 END
  733.                             END
  734.                         END;
  735.                         Texts.Delete(t, pos, end); TextFrames.SetCaret(tf, pos)
  736.                     END
  737.                 ELSE handled := FALSE
  738.                 END    (* CASE msg.ch ... *)
  739.             ELSE handled := FALSE
  740.             END    (* IF msg.id = ... *)
  741.         | msg: Oberon.CopyOverMsg DO    (* allow copy over only if text has no partial folds in it *)
  742.             IF ~tf.hasCar OR ~PartialFolds(msg.text, msg.beg, msg.end) THEN handled := FALSE END
  743.         ELSE handled := FALSE
  744.         END;        (* WITH msg: ... *)
  745.         IF ~handled THEN TextFrames.Handle(tf, msg) END
  746.     END Handle;
  747.     (** Commands **)
  748.     PROCEDURE Open*;    (** (name | "^")    Open a user viewer containing a text **)
  749.         CONST
  750.             menu1 =
  751.         "System.Close System.Copy System.Grow XE.Search Edit.Replace All XE.Comp XE.Err Edit.Store ";
  752.             menu2 =
  753.         "System.Close System.Copy System.Grow Edit.Search Edit.Replace All Edit.Parcs Edit.Store ";
  754.         VAR
  755.             v: Viewers.Viewer; f: TextFrames.Frame; t: Texts.Text; s: Texts.Scanner;
  756.             name, menu: LongName; i, x, y: INTEGER; pos: LONGINT;
  757.     BEGIN
  758.         ScanFirst(s); OpenText(t, name, s, "Empty.Mod", ".Mod", ".Text");
  759.         i := 0; REPEAT INC(i) UNTIL name[i] = 0X;
  760.         IF (i > 3) & (name[i-3] = "M") & (name[i-2] = "o") & (name[i-1] = "d") THEN menu := menu1
  761.         ELSE menu := menu2
  762.         END;
  763.         Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  764.         f := TextFrames.NewText(t, 0);
  765.         v := MenuViewers.New(MenuFrame(name, menu, 0), f, TextFrames.menuH, x, y);
  766.         f.handle := Handle;
  767.         IF find.len > 0 THEN    (* simulate Edit.Show *)
  768.             Find(t, 0, pos);
  769.             IF pos > 0 THEN
  770.                 DEC(pos, find.len);
  771.                 TextFrames.Show(f, pos); TextFrames.SetSelection(f, pos, pos+find.len-1);
  772.                 TextFrames.SetCaret(f, pos+find.len-1)
  773.             END
  774.         END
  775.     END Open;
  776. (*    PROCEDURE OpenWide*;    (** (name | "^")    Open a user viewer containing a text **)
  777.         CONST
  778.             menu1 =
  779.         "System.Close System.Copy System.Grow XE.Search Edit.Replace All XE.Comp XE.Err Edit.Store | Log.Open | XE.SysOpen 57 Strip ";
  780.             menu2 =
  781.         "System.Close System.Copy System.Grow Edit.Search Edit.Replace All Edit.Parcs Edit.Store | Log.Open | XE.SysOpen 57 Strip ";
  782.         VAR
  783.             v: Viewers.Viewer; mf: TextFrames.Frame; t: Texts.Text; s: Texts.Scanner;
  784.             name, menu: ARRAY 128 OF CHAR; i, x, y: INTEGER;
  785.     BEGIN
  786.         ScanFirst(s); OpenText(t, name, s, "Empty.Mod", ".Mod", ".Text");
  787.         i := 0; REPEAT INC(i) UNTIL name[i] = 0X;
  788.         IF (i > 3) & (name[i-3] = "M") & (name[i-2] = "o") & (name[i-1] = "d") THEN menu := menu1
  789.         ELSE menu := menu2
  790.         END;
  791.         Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  792.         mf := MenuFrame(name, menu, 2);
  793.         Oberon.OpenTrack(Oberon.UserTrack(Oberon.Mouse.X), Oberon.DisplayWidth(Oberon.Mouse.X));
  794.         v := MenuViewers.New(mf, TextFrames.NewText(t, 0), TextFrames.menuH, x, y);
  795.         v.dsc.next.handle := Handle
  796.     END OpenWide;
  797.     PROCEDURE SysOpen*;    (** [defY] (name | "^")    Open a system viewer at defY **)
  798.         CONST
  799.             menuCommands = "System.Close  System.Grow  Edit.Parcs  Edit.Store ";
  800.         VAR
  801.             v: Viewers.Viewer; t: Texts.Text;
  802.             s: Texts.Scanner; name: LongName; x, defY, y: INTEGER;
  803.             default: BOOLEAN;
  804.     BEGIN
  805.         ScanFirst(s);
  806.         IF s.class = Texts.Int THEN    (* read desired Y-coordinate *)
  807.             defY := SHORT(s.i); default := TRUE; Oberon.Par.pos := Texts.Pos(s)-1; ScanFirst(s)
  808.         ELSE default := FALSE
  809.         END;
  810.         OpenText(t, name, s, "Empty.Tool", ".Tool", ".Tool");
  811.         Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y);
  812.         IF default THEN y := defY END;
  813.         v := MenuViewers.New(MenuFrame(name, menuCommands, 1), TextFrames.NewText(t, 0), TextFrames.menuH,x,y);
  814.         v.dsc.next.handle := Handle
  815.     END SysOpen;
  816.     PROCEDURE Search*;    (** Search selection (in folds if viewer is marked) **)
  817.         VAR res: INTEGER;
  818.     BEGIN
  819.         IF Oberon.Pointer.on & (Oberon.Par.vwr = Oberon.MarkedViewer()) THEN
  820.             Oberon.Call("FoldElems.Search", Oberon.Par, FALSE, res)
  821.         ELSE Oberon.Call("Edit.Search", Oberon.Par, FALSE, res)
  822.         END
  823.     END Search;
  824.     PROCEDURE Err*;    (** Show next error after caret **)
  825.         VAR f: TextFrames.Frame; v: Viewers.Viewer; pos: LONGINT; e: Texts.Elem;
  826.     BEGIN
  827.         IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN    (* called from menu frame *)
  828.             IF (Oberon.Par.frame.next # NIL) & (Oberon.Par.frame.next IS TextFrames.Frame) THEN
  829.                 f := Oberon.Par.frame.next(TextFrames.Frame)
  830.             ELSE f := NIL
  831.             END
  832.         ELSE
  833.             v := Oberon.MarkedViewer();
  834.             IF (v.dsc # NIL) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN f := v.dsc.next(TextFrames.Frame)
  835.             ELSE f := NIL
  836.             END
  837.         END;
  838.         IF f # NIL THEN
  839.             IF f.hasCar THEN pos := f.carloc.pos ELSE pos := 0 END;
  840.             FoldElems.FindElem(f.text, pos, ErrCheck, e, pos);
  841.             IF e # NIL THEN
  842.                 (*TextFrames.*)Show(f, pos); e(Elem).pos := pos; UpdateErr(e(Elem));
  843.                 Oberon.PassFocus(Viewers.This(f.X, f.Y)); TextFrames.SetCaret(f, pos+1)
  844.             ELSIF f.hasCar THEN TextFrames.RemoveCaret(f)
  845.             END
  846.         END
  847.     END Err;
  848.     PROCEDURE Comp*;    (** [options] | "*" | "^" | {fileName [options]}    Compile viewer in main frame with options
  849.         or marked viewer or list of filenames with options **)
  850.         VAR
  851.             f: TextFrames.Frame; menuT: Texts.Text; s: Texts.Scanner; v: Viewers.Viewer;
  852.             len: LONGINT; options: Name; fileName: LongName;
  853.         PROCEDURE Compile(frame: TextFrames.Frame; text: Texts.Text; name: ARRAY OF CHAR);
  854.             VAR
  855.                 vwr: MenuViewers.Viewer; oldNotify: Texts.Notifier; logLen: LONGINT; x, y, h: INTEGER;
  856.                 this, prev: Element; ext: Name; errorFile: LongName; res: INTEGER;
  857.         BEGIN
  858.             IF text # NIL THEN
  859.                 COPY(DefErrFile, errorFile);
  860.                 IF (compiler = "") & (name # "") OR (frame = NIL) THEN    (* no compile command yet, check extension *)
  861.                     COPY(defComp, compiler);
  862.                     Extension(name, ext); this := SearchPair(ext, prev);
  863.                     IF this # NIL THEN COPY(this.compiler, compiler); COPY(this.errFile, errorFile) END
  864.                 END;
  865.                 errT := TextFrames.Text(errorFile);
  866.                 oldNotify := text.notify; text.notify := NoNotify;
  867.                 FoldElems.ExpandAll(text, 0, TRUE);
  868.                 IF frame = NIL THEN    (* create temporary viewer *)
  869.                     x := Display.Width-1; y := Display.Bottom; h := Viewers.minH; Viewers.minH := 1;
  870.                     vwr := MenuViewers.New(TextFrames.NewMenu("", ""),
  871.                         TextFrames.NewText(text, 0), TextFrames.menuH, x, y
  872.                     );
  873.                     Oberon.Pointer.X := x; Oberon.Pointer.Y := y;
  874.                     Viewers.minH := h
  875.                 ELSE DeleteErrElems(text)
  876.                 END;
  877.                 (* create new parameter text for compiler *)
  878.                 Oberon.Par.text := TextFrames.Text(""); Oberon.Par.pos := 0;
  879.                 Ch("*"); Str(options); Texts.Append(Oberon.Par.text, wr.buf);
  880.                 Str(compiler); Ch(" "); Str(options); Texts.Append(Oberon.Log, wr.buf);
  881.                 Append(".Compile", compiler);    (* extend compiler command, if necessary *)
  882.                 logLen := Oberon.Log.len;
  883.                 Oberon.Call(compiler, Oberon.Par, FALSE, res);
  884.                 IF (res = 0) & (frame # NIL) THEN MarkErrors(frame, text, logLen) END;
  885.                 FoldElems.CollapseAll(text, {FoldElems.tempLeft});
  886.                 IF frame = NIL THEN Viewers.Close(vwr)
  887.                 ELSE text.notify := oldNotify; text.notify(text, Texts.replace, 0, text.len)
  888.                 END
  889.             END
  890.         END Compile;
  891.     BEGIN
  892.         menuT := NIL;
  893.         IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN    (* called from menu frame *)
  894.             IF (Oberon.Par.frame.next # NIL) & (Oberon.Par.frame.next IS TextFrames.Frame) THEN
  895.                 f := Oberon.Par.frame.next(TextFrames.Frame);
  896.                 menuT := Oberon.Par.frame(TextFrames.Frame).text    (* menu text *)
  897.             END
  898.         ELSE    (* allow XE.Comp * ... *)
  899.             ScanFirst(s);
  900.             IF (s.class = Texts.Char) & (s.c = "*") & (s.line = 0) THEN
  901.                 Oberon.Par.pos := Texts.Pos(s);
  902.                 v := Oberon.MarkedViewer();
  903.                 IF (v IS MenuViewers.Viewer) & (v.dsc.next # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
  904.                     f := v.dsc.next(TextFrames.Frame);
  905.                     menuT := v.dsc(TextFrames.Frame).text    (* menu text *)
  906.                 END
  907.             END
  908.         END;
  909.         IF menuT # NIL THEN
  910.             ScanFirst(s); compiler := ""; fileName := "";
  911.             IF (s.class = Texts.Name) & (s.line = 0) THEN    (* get compiler override name *)
  912.                 COPY(s.s, compiler); Texts.Scan(s)
  913.             END;
  914.             GetOptions(s, options);
  915.             IF compiler = "" THEN
  916.                 Texts.OpenScanner(s, menuT, 0); Texts.Scan(s);
  917.                 IF s.class = Texts.Name THEN COPY(s.s, fileName) END
  918.             END;
  919.             len := menuT.len;
  920.             Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, f.X, f.Y); Oberon.FadeCursor(Oberon.Pointer);
  921.             Compile(f, f.text, fileName);
  922.             IF len # menuT.len THEN    (* text was stored and got an UpdateMsg -> ! char in menu text *)
  923.                 Texts.Delete(menuT, menuT.len-1, menuT.len)
  924.             END;
  925.             Err    (* show first error, if any *)
  926.         ELSE    (* compile file list: {fileName [options] } ~ *)
  927.             ScanFirst(s);
  928.             WHILE s.class = Texts.Name DO
  929.                 COPY(s.s, fileName); Texts.Scan(s); GetOptions(s, options);
  930.                 Compile(NIL, TextFrames.Text(fileName), fileName)
  931.             END
  932.         END
  933.     END Comp;
  934.     PROCEDURE Compiler*;    (** [(Compiler  [Ext  [ErrFile]] | "^")]    Install or list compiler, extension, errorfile set **)
  935.         VAR s: Texts.Scanner; line: INTEGER; errorFile: LongName; new, this, prev: Element;
  936.     BEGIN
  937.         ScanFirst(s);
  938.         IF s.class = Texts.Name THEN
  939.             line := s.line;
  940.             COPY(s.s, compiler);
  941.             Str("XE using "); Str(compiler);
  942.             Texts.Scan(s);
  943.             IF (s.class = Texts.Name) & (s.line = line) THEN
  944.                 NEW(new); COPY(compiler, new.compiler); COPY(s.s, new.ext);
  945.                 Texts.Scan(s);
  946.                 IF (s.class = Texts.Name) & (s.line = line) THEN
  947.                     COPY(s.s, errorFile); Append("Errors.Text", errorFile);
  948.                     errT := TextFrames.Text(errorFile);
  949.                     IF errT.len = 0 THEN errT := TextFrames.Text(DefErrFile); COPY(DefErrFile, errorFile) END
  950.                 ELSE errT := TextFrames.Text(DefErrFile); COPY(DefErrFile, errorFile)
  951.                 END;
  952.                 COPY(errorFile, new.errFile);
  953.                 this := SearchPair(new.ext, prev);    (* check for duplicates *)
  954.                 IF this = NIL THEN new.next := root; root := new    (* new entry *)
  955.                 ELSIF this.compiler # new.compiler THEN    (* new entry for existing extension -> remove this *)
  956.                     IF this = root THEN new.next := root.next; root := new
  957.                     ELSE new.next := this.next; prev.next := new
  958.                     END
  959.                 END;
  960.                 Str(" and "); Str(new.errFile); Str(" for *."); Str(new.ext)
  961.             ELSE COPY(compiler, defComp); Str(" as default")
  962.             END;
  963.             Ln
  964.         ELSE
  965.             Str("XE.Compiler"); Ln;
  966.             this := root;
  967.             WHILE this # NIL DO
  968.                 Str(this.compiler ); Ch(" "); Str(this.errFile); Str(" *."); Str(this.ext); Ln;
  969.                 this := this.next
  970.             END;
  971.             IF defComp # "" THEN Str(defComp); Ch(" "); Str(DefErrFile); Str(" *"); Ln END
  972.         END
  973.     END Compiler;
  974.     PROCEDURE GetHandler*;    (** install XE.Handle in Oberon.Par.frame.handle, if Oberon.Par.pos = GetHandlerKey **)
  975.     BEGIN
  976.         IF (Oberon.Par.pos = GetHandlerKey) & (Oberon.Par.frame # NIL) THEN Oberon.Par.frame.handle := Handle END
  977.     END GetHandler;
  978. BEGIN
  979.     Texts.OpenWriter(wr); errFnt := Fonts.This(ErrFont); root := NIL; first := TRUE; defComp := DefComp
  980. END XE.
  981.